home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / dev / e / UnfinishedEsrc.lha / PROJECTS / bbs.e next >
Text File  |  1999-01-06  |  7KB  |  237 lines
  1. ->By Ian Chapman
  2. ->This is one of my first half decent BBS intros, it includes a nice but simple scroller
  3. ->followed by a rotating filled vector cube. LMB and RMB zooms in and out, bother together
  4. ->quits. The MOD was not created by me.
  5.  
  6. OPT OSVERSION=39
  7.  
  8. MODULE 'intuition/intuition',
  9.        'intuition/screens',
  10.        'tools/filledvector',
  11.        'tools/filledvdefs',
  12.        'tools/scrbuffer',
  13.        'graphics/rastport',
  14.        'protracker',
  15.        'exec/memory'
  16.           
  17. CONST   SWIDTH=640,
  18.         SHEIGHT=256,
  19.         FWIDTH=8,
  20.         FHEIGHT=12
  21.  
  22. DEF scrv,
  23.     polycon,
  24.     cube:PTR TO vobject,
  25.     rastv:rastport,
  26.     mem,
  27.     scr:PTR TO screen,
  28.     rast,
  29.     count,
  30.     text[1000]:STRING,
  31.     col,inc
  32.  
  33. PROC main()
  34.  
  35. col:=20
  36. inc:=20
  37.  
  38. IF (ptbase:=OpenLibrary('protracker.library',1))<>NIL
  39.     mem:=NewM(31000,MEMF_CHIP)
  40.     CopyMem({file},mem,19275)
  41.     Mt_StartInt(mem)
  42. ENDIF
  43.  
  44. IF (scr:=OpenS(SWIDTH,SHEIGHT,6,$8000,'Jelly Scroll',NIL))<>NIL
  45.  
  46.  
  47.     StrCopy(text,'Welcome to a nice little intro entirely coded in Amiga E by Ian Chapman. To pause this scroller at any time just hold down LMB. The reason for this intro?     To plug my BBS of course :) .   For the best in Amiga, PC, Mac, Acorn, Atari and UNIX Call THE JELLY ZONE (num removed) 24hrs!.                          Greetz to (Names Removed)                                 Well the next part of the intro is a nice rotating vector cube. Use LMB to Zoom in and use RMB to Zoom out. Press both Mouse Buttons to exit. Thats it from me!!!                                                                           Powered By AMIGA                           ')
  48.     rast:=scr.rastport
  49.     count:=0
  50.     SetColour(scr,0,0,0,0)
  51.     SetColour(scr,1,0,0,0)
  52.     SetColour(scr,2,255,255,255)
  53.     Colour(2)
  54.  
  55.     scroll(FWIDTH,FHEIGHT,1,0,123)
  56.  
  57.     CloseS(scr)
  58. ELSE
  59.     PrintF('Unable to open main screen!\n')
  60. ENDIF
  61.  
  62.  
  63. -> Initialise the empty Rast port for drawing
  64. InitRastPort(rastv)
  65.  
  66. ->Open a buffered screen
  67. scrv:=sb_OpenScreen([SA_DEPTH,4,SA_WIDTH,320,SA_HEIGHT,256,0],0);
  68.  
  69.  
  70. polycon:=newPolyContext(sb_GetBitMap(scrv),50)
  71. setPolyFlags(polycon,1,1)
  72.  
  73.  
  74. ->Set up the cube. First do the point distances followed
  75. ->by the joining of the points.
  76.  
  77.  
  78. cube:=newVectorObject(0,
  79.                         8,
  80.                         6,
  81.                         [-150,150,-150,
  82.                         150,150,-150,
  83.                         150,-150,-150,
  84.                         -150,-150,-150,
  85.                         -150,150,150,
  86.                         150,150,150,
  87.                         150,-150,150,
  88.                         -150,-150,150]:INT,
  89.                         [0,1,2,1,[4,0,1,1,2,2,3,3,0]:INT,0,
  90.                         6,5,4,2,[4,5,4,4,7,7,6,6,5]:INT,0,
  91.                         1,5,6,3,[4,1,5,5,6,6,2,2,1]:INT,0,
  92.                         4,0,3,4,[4,4,0,0,3,3,7,7,4]:INT,0,
  93.                         4,5,1,5,[4,4,5,5,1,1,0,0,4]:INT,0,
  94.                         3,2,6,6,[4,3,2,2,6,6,7,7,3]:INT,0]:face);
  95. /*
  96.  
  97.  
  98. cube:=newVectorObject(0,20,12,
  99.         [-178*3,98*3,20*4,      /* points */
  100.         -34*3,98*3,20*4,
  101.         -34*3,66*3,20*4,
  102.         -146*3,-50*3,20*4,
  103.         -34*3,-50*3,20*4,
  104.         -34*3,-82*3,20*4,
  105.         -178*3,-82*3,20*4,
  106.         -178*3,-50*3,20*4,
  107.         -66*3,66*3,20*4,
  108.         -178*3,66*3,20*4,
  109.         -178*3,98*3,-20*4,      /* lower side */
  110.         -34*3,98*3,-20*4,
  111.         -34*3,66*3,-20*4,
  112.         -146*3,-50*3,-20*4,
  113.         -34*3,-50*3,-20*4,
  114.         -34*3,-82*3,-20*4,
  115.         -178*3,-82*3,-20*4,
  116.         -178*3,-50*3,-20*4,
  117.         -66*3,66*3,-20*4,
  118.         -178*3,66*3,-20*4]:INT,
  119.         /* since no 'depth' sorting is done - ensure innermost surfaces drawn first */
  120.         [3,4,14,1,      /* bottom inside edge */
  121.                 [4,3,4,4,14,14,13,13,3]:INT,0,
  122.         8,9,19,2,       /* top inside edge */
  123.                 [4,8,9,9,19,19,18,18,8]:INT,0,
  124.  
  125.         2,3,13,3,       /* sloping inside edge */
  126.                 [4,2,3,3,13,13,12,12,2]:INT,0,
  127.         7,8,18,4,       /* sloping inside edge-left */
  128.                 [4,7,8,8,18,18,17,17,7]:INT,0,
  129.  
  130.         2,1,0,5,        /* front face */
  131.                 [10,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,0]:INT,0,
  132.         10,11,12,6,     /* back face */
  133.                 [10,10,11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18,19,19,10]:INT,0,
  134.         0,1,11,7,       /* top bar of z */
  135.                 [4,0,1,1,11,11,10,10,0]:INT,0,
  136.         5,6,16,8,       /* bottom bar of z */
  137.                 [4,5,6,6,16,16,15,15,5]:INT,0,
  138.         1,2,12,9,       /* first back end */
  139.                 [4,1,2,2,12,12,11,11,1]:INT,0,
  140.         4,5,15,10,      /* next back end */
  141.                 [4,4,5,5,15,15,14,14,4]:INT,0,
  142.         6,7,17,11,      /* left lower end */
  143.                 [4,6,7,7,17,17,16,16,6]:INT,0,
  144.         9,0,10,12,      /* upper left end */
  145.                 [4,9,0,0,10,10,19,19,9]:INT,0]:face);
  146.  
  147. */
  148. cube.pz:=9000
  149.  
  150. WHILE cube.pz>1300
  151.     rastv.bitmap:=sb_NextBuffer(scrv);
  152.     SetRast(rast,0)
  153.     setPolyBitMap(polycon, rastv.bitmap)
  154.     drawVObject(polycon, cube)
  155.  
  156.     cube.ax:=cube.ax+1
  157.     cube.ay:=cube.ay+2
  158.     cube.az:=cube.az+3
  159. cube.pz:=cube.pz-200
  160. ENDWHILE
  161.  
  162. WHILE Mouse()<>3  ->Check for both mouse button presses.
  163.     rastv.bitmap:=sb_NextBuffer(scrv);
  164.     SetRast(rastv,0)
  165.     setPolyBitMap(polycon, rastv.bitmap)
  166.     drawVObject(polycon, cube)
  167.  
  168.     cube.ax:=cube.ax+1
  169.     cube.ay:=cube.ay+2
  170.     cube.az:=cube.az+3
  171.     IF Mouse()=1 THEN cube.pz:=cube.pz-30 ->Zoom in on left button
  172.     IF Mouse()=2 THEN cube.pz:=cube.pz+30 ->Zoom out on right
  173. ENDWHILE
  174.  
  175. WHILE cube.pz<12000
  176.     rastv.bitmap:=sb_NextBuffer(scrv);
  177.     SetRast(rastv,0)
  178.     setPolyBitMap(polycon, rastv.bitmap)
  179.     drawVObject(polycon, cube)
  180.  
  181.     cube.ax:=cube.ax+1
  182.     cube.ay:=cube.ay+2
  183.     cube.az:=cube.az+3
  184.  
  185. cube.pz:=cube.pz+200
  186.  
  187. ENDWHILE
  188.  
  189. freeVectorObject(cube)
  190. sb_CloseScreen(scrv)
  191.  
  192. IF ptbase<>NIL
  193.     Mt_StopInt()
  194.     CloseLibrary(ptbase)
  195. ENDIF
  196.  
  197. PrintF('Remember the kewlest board around!\nThe Jelly Zone (Number Removed) 24 hrs!\n')
  198.  
  199. ENDPROC
  200.  
  201. PROC scroll(fontwidth,fontheight,deltax,deltay,scrollbase)
  202. DEF x,letter,out[2]:STRING
  203.  
  204. WHILE letter>-1
  205.     letter:=letterproc()
  206.     StringF(out,'\c',letter)
  207.     TextF(SWIDTH-FWIDTH,scrollbase-3,out)
  208.     col:=col+inc
  209.     IF (col=240) OR (col=20) THEN inc:=inc*-1
  210.     SetColour(scr,2,col,0,col)
  211.     WHILE Mouse()=1
  212.     ENDWHILE
  213.  
  214.     FOR x:=1 TO fontwidth
  215.  
  216.         ScrollRaster(rast,deltax,deltay,0,scrollbase-fontheight,SWIDTH,scrollbase)
  217.     ENDFOR
  218.  
  219. ENDWHILE
  220.  
  221. ENDPROC
  222.  
  223.  
  224. PROC letterproc()
  225. DEF theletter,length
  226. length:=EstrLen(text)
  227.  
  228. IF count=length THEN theletter:=-5 ELSE theletter:=text[count]
  229.  
  230. count:=count+1
  231.  
  232. ENDPROC theletter
  233.  
  234. file:
  235. INCBIN 'cabbage.mod'
  236.  
  237.